perm filename TAX.F4[TAX,LCS] blob
sn#153772 filedate 1975-04-10 generic text, type T, neo UTF8
C***** INCOME TAX HELPER ******
CC DIMENSION WAGES(10),DIV(10),RINT(10),BINC(10),
CC 1 CAS(10),SUPS(10),ROY(10),PENS(10),CAPG(10),SITR(10),
CC 1 OTH(10),EBEX(10),RMED(20),TAXES(10),XOTH(10),CONTR(10),
CC 1 TLOSS(10),RMIN(10),DOC(10),DOTH(10),RTAX(10),RMORT(10),
CC 1 ROTH(10),OCONT(10),OCASH(10),UNION(10),RMOTH(10),WTAX(10)
CC 1,ETAX(10),FICA(10)
COMMON K,ACC,IOUT
IOUT=5
C**** -99=BACKUP ************** -999 SKIPS SOME SECTIONS, -888 SKIPS TO END
C*** UP TO 10 NUMBERS MAY BE ENTERED IF PROG. GIVES <CR> BEFORE ACCEPT.
C 5=TTY 3=LPT
ACC=-1
TYPE 200
ACCEPT 3,N
IF(N.NE.'O')GO TO 60
200 FORMAT(' N=NEW TAX WORK -- OR O=GET OLD FILE. H=HELP'/)
TYPE 85
ACCEPT 4,NAME
GO TO 201
33 FORMAT('+ STANDARD DEDUCTION - NOT MORE THAN $2000 OR $1000'/)
60 FORMAT('+ TOTAL--- ',F10.2/)
IF(N.NE.'H')GO TO 4
TYPE 202
CALL EXIT
202 FORMAT(' ASK LCS FOR INFORMATION.')
1 FORMAT(20F)
2 FORMAT(F10.2/)
3 FORMAT(A1)
4 FORMAT(A5)
I=' '
601 FORMAT(' ***** YOU ARE ON FORM 1040, PG.1 *****'/)
WRITE(IOUT,601)
IF(ACC.EQ.0)GO TO 102
TYPE 604
604 FORMAT(' TO BACKUP TYPE -99 '/)
600 FORMAT('+ ARE YOU MARRIED, FILING SEPARATELY? '$)
CALL TYP(3,I)
TYPE 600
ACCEPT 3,MFS
IF(RIC.EQ.-888)GO TO 6901
102 CALL TYP(7,I)
WRITE(IOUT, 11)
11 FORMAT('+ NUMBER OF EXEMPTIONS ',$)
CALL ADUP(EX)
IF(EX.EQ.-99)GO TO 600
1100 CALL TYP(9,I)
WRITE(IOUT, 12)
12 FORMAT('+ WAGES, ETC. (FROM W2 FORMS) '/)
CALL ADUP(WG)
IF(WG.EQ.-99)GO TO 102
103 CALL TYP(10,'A')
WRITE(IOUT, 13)
13 FORMAT('+ DIVIDENDS.'/)
CALL ADUP(DT)
IF(DT.EQ.-99)GO TO 102
IF(DT.EQ.0)GO TO 105
104 CALL TYP(10,'B')
WRITE(IOUT, 14)
14 FORMAT('+ DIVIDEND EXCLUSION. ',$)
CALL ADUP(DEX)
IF(DEX.EQ.-99)GO TO 103
TOTD=DT-DEX
CALL TYP(10,'C')
WRITE(IOUT, 15)TOTD
15 FORMAT('+ TOTAL DIVIDENDS. ',F11.2/)
105 CALL TYP(11,I)
WRITE(IOUT, 16)
16 FORMAT('+ INTEREST INCOME. '/)
CALL ADUP(RT)
IF(RT.EQ.-99)GO TO 104
106 CALL TYP(12,I)
WRITE(IOUT, 17)
17 FORMAT('+ OTHER INCOME.'/)
602 FORMAT(' ***** GO TO PAGE 2 OF FORM 1040 *****'/,
1' ***** TYPE -999 TO SKIP OVER SECTION AND RETURN TO PG.1'/
1' ***** -888 SKIPS TO LINE 44')
IF(ACC.EQ.0.AND.T38.EQ.0)GO TO 1603
WRITE(IOUT,602)
CALL TYP(28,I)
WRITE(IOUT, 18)
18 FORMAT('+ BUSINESS INCOME-LOSS.'/)
CALL ADUP(BI)
IF(BI.EQ.-999)GO TO 1603
IF(BI.EQ.-888)GO TO 6901
IF(BI.EQ.-99)GO TO 105
107 CALL TYP(29,I)
WRITE(IOUT, 19)
19 FORMAT('+ CAPITAL ASSETS.'/)
CALL ADUP(CA)
IF(CA.EQ.-99)GO TO 106
108 CALL TYP(30,I)
WRITE(IOUT, 20)
20 FORMAT('+ SUPPLEMENTAL SCHEDULE.'/)
CALL ADUP(SU)
IF(SU.EQ.-99)GO TO 107
109 CALL TYP(31,I)
WRITE(IOUT, 21)
21 FORMAT('+ RENTS, ROYALTIES, ETC.'/)
CALL ADUP(RY)
IF(RY.EQ.-99)GO TO 108
110 CALL TYP(33,I)
WRITE(IOUT, 22)
22 FORMAT('+ PENSIONS, ETC.'/)
CALL ADUP(PE)
IF(PE.EQ.-99)GO TO 109
111 CALL TYP(34,I)
WRITE(IOUT, 23)
23 FORMAT('+ 50% CAPITAL GAIN.'/)
CALL ADUP(CP)
IF(CP.EQ.-99)GO TO 110
112 CALL TYP(35,I)
WRITE(IOUT, 24)
24 FORMAT('+ STATE INCOME TAX REFUNDS.'/)
CALL ADUP(SI)
IF(SI.EQ.-99)GO TO 111
113 CALL TYP(36,I)
WRITE(IOUT, 25)
25 FORMAT('+ ALIMONY INCOME. '/)
CALL ADUP(ALM)
IF(ALM.EQ.-99)GO TO 112
114 CALL TYP(37,I)
WRITE(IOUT, 26)
26 FORMAT('+ OTHER.'/)
CALL ADUP(OT)
IF(OT.EQ.-99)GO TO 113
CALL TYP(38,I)
T38=BI+CA+SU+RY+PE+CP+SI+ALM+OT
WRITE(IOUT, 60)T38
603 FORMAT(' ***** GO BACK TO PAGE 1 OF FORM 1040 *****'/)
WRITE(IOUT,603)
1603 CALL TYP(12,I)
IF(BI.EQ.-999)BI=0
WRITE(IOUT,60)T38
CALL TYP(13,I)
T13=WG+TOTD+RT+T38
WRITE(IOUT, 60)T13
115 CALL TYP(14,I)
WRITE(IOUT, 27)
27 FORMAT('+ ADJUSTMENTS TO INCOME'/)
IF(ACC.EQ.0.AND.T43.EQ.0)GO TO 1604
WRITE(IOUT,602)
CALL TYP(39,I)
WRITE(IOUT, 28)
28 FORMAT('+ SICK PAY. ',/)
CALL ADUP(SICK)
IF(SICK.EQ.-999)GO TO 1604
IF(SICK.EQ.-888)GO TO 6901
IF(SICK.EQ.-99)GO TO 114
116 CALL TYP(40,I)
WRITE(IOUT, 29)
29 FORMAT('+ MOVING EXPENSES. ',/)
CALL ADUP(RMEX)
IF(RMEX.EQ.-99)GO TO 115
117 CALL TYP(41,I)
WRITE(IOUT, 30)
30 FORMAT('+ EMPLOYEE BUSINESS EXPENSES.'/)
CALL ADUP(EB)
IF(EB.EQ.-99)GO TO 116
118 CALL TYP(42,I)
WRITE(IOUT, 31)
31 FORMAT('+ SELF-EMPLOYED RETIREMENT PLAN. '/)
CALL ADUP(SER)
IF(SER.EQ.-99)GO TO 117
CALL TYP(43,I)
T43=SICK+RMEX+EB+SER
WRITE(IOUT, 60)T43
WRITE(IOUT,603)
1604 CALL TYP(14,I)
IF(SICK.EQ.-999)SICK=0
WRITE(IOUT, 60)T43
T15=T13-T43
CALL TYP(15,I)
WRITE(IOUT, 32)T15
32 FORMAT('+ ADJUSTED GROSS INCOME.',F13.2/)
IF(T15.LT.10000.)CALL SMALL(T15)
CALL STDED(T15)
IF(ACC)WRITE(IOUT, 34)
34 FORMAT(/' ***** ITEMIZE DEDUCTIONS? '$)
IF(ACC)ACCEPT 3,JIT
IF(JIT.EQ.'N')GO TO 6900
C*************************************
119 WRITE(IOUT, 35)
35 FORMAT(/' ***** GO TO SCHEDULE A *****')
WRITE(IOUT, 36)
36 FORMAT(/' ----- MEDICAL - DENTAL '/)
IF(ACC.EQ.0)GO TO 3700
CALL TYP(1,I)
WRITE(IOUT, 37)
37 FORMAT('+ TOTAL OF INSURANCE PREMIUMS. '/)
CALL ADUP(RMI)
IF(RMI.EQ.-99)GO TO 118
3700 T1=RMI/2.
IF(T1.GT.150.)T1=150.
CALL TYP(1,I)
WRITE(IOUT, 2)T1
120 CALL TYP(2,I)
WRITE(IOUT, 38)
38 FORMAT('+ MEDICINE AND DRUGS. '/)
CALL ADUP(RM)
IF(RM.EQ.-99)GO TO 119
CALL TYP(3,I)
61 FORMAT('+ 1% OF LINE 15-- ',F10.2/)
ONP=T15/100.
WRITE(IOUT, 61)ONP
T4=RM-ONP
IF(T4)T4=0
CALL TYP(4,I)
WRITE(IOUT, 2)T4
CALL TYP(5,I)
T5=RMI-T1
IF(T5)T5=0
62 FORMAT('+ BALANCE OF INSURANCE PREMIUMS. ',F10.2/)
WRITE(IOUT, 62)T5
CALL TYP(6,I)
WRITE(IOUT, 39)
39 FORMAT('+ OTHER MEDICAL AND DENTAL EXPENSES.'/)
121 CALL TYP(6,'A')
WRITE(IOUT, 40)
40 FORMAT('+ DOCTORS, DENTISTS, ETC.'/)
CALL ADUP(DO)
IF(DO.EQ.-99)GO TO 120
122 CALL TYP(6,'B')
WRITE(IOUT, 41)
41 FORMAT('+ HOSPITALS.'/)
CALL ADUP(HOSP)
IF(HOSP.EQ.-99)GO TO 121
123 CALL TYP(6,'C')
WRITE(IOUT, 26)
CALL ADUP(DOTH)
IF(DOTH.EQ.-99)GO TO 122
T7=T4+T5+DO+HOSP+DOTH
CALL TYP(7,I)
WRITE(IOUT, 60)T7
T8=T15*.03
CALL TYP(8,I)
WRITE(IOUT, 2)T8
T9=T7-T8
IF(T9)T9=0
CALL TYP(9,I)
WRITE(IOUT, 2)T9
T10=T9+T1
CALL TYP(10,I)
WRITE(IOUT, 60)T10
CALL TYP(35,I)
WRITE(IOUT, 60)T10
43 FORMAT(/' ----- TAXES'/)
WRITE(IOUT, 43)
124 CALL TYP(11,I)
WRITE(IOUT, 44)
44 FORMAT('+ STATE AND LOCAL INCOME.'/)
CALL ADUP(TA)
IF(TA.EQ.-99)GO TO 123
125 CALL TYP(12,I)
WRITE(IOUT, 45)
45 FORMAT('+ REAL ESTATE.'/)
CALL ADUP(RX)
IF(RX.EQ.-99)GO TO 124
126 CALL TYP(13,I)
WRITE(IOUT, 42)
42 FORMAT('+ GASOLINE TAX (SEE TABLES) '/)
CALL ADUP(GTAX)
IF(GTAX.EQ.-99)GO TO 125
127 CALL TYP(14,I)
WRITE(IOUT, 46)
46 FORMAT('+ GENERAL SALES. (SEE TABLES) '/)
CALL ADUP(STAX)
IF(STAX.EQ.-99)GO TO 126
128 CALL TYP(15,I)
WRITE(IOUT, 47)
47 FORMAT('+ PERSONAL PROPERTY'/)
CALL ADUP(PTAX)
IF(PTAX.EQ.-99)GO TO 127
129 CALL TYP(16,I)
WRITE(IOUT, 26)
CALL ADUP(XO)
IF(XO.EQ.-99)GO TO 128
CALL TYP(17,I)
T17=TA+RX+GTAX+STAX+PTAX+XO
WRITE(IOUT, 60)T17
CALL TYP(36,I)
WRITE(IOUT, 60)T17
130 WRITE(IOUT, 48)
48 FORMAT(/' ----- INTEREST EXPENSE'/)
CALL TYP(18,I)
WRITE(IOUT, 49)
49 FORMAT('+ HOME MORTGAGE.'/)
CALL ADUP(RMO)
IF(RMO.EQ.-99)GO TO 129
131 CALL TYP(19,I)
WRITE(IOUT, 26)
CALL ADUP(ROH)
IF(ROH.EQ.-99)GO TO 130
CALL TYP(20,I)
T20=RMO+ROH
WRITE(IOUT, 60)T20
CALL TYP(37,I)
WRITE(IOUT, 60)T20
132 WRITE(IOUT, 50)
50 FORMAT(/' ----- CONTRIBUTIONS '/)
CALL TYP(21,'A')
WRITE(IOUT, 51)
51 FORMAT('+ CASH CONTRIBUTIONS.'/)
CALL ADUP(CO)
IF(CO.EQ.-99)GO TO 131
133 CALL TYP(21,'B')
WRITE(IOUT, 26)
CALL ADUP(OC)
IF(OC.EQ.-99)GO TO 132
134 CALL TYP(22,I)
WRITE(IOUT, 510)
510 FORMAT('+ OTHER THAN CASH (SEE PAGE 12).'/)
CALL ADUP(OCA)
IF(OCA.EQ.-99)GO TO 133
135 CALL TYP(23,I)
WRITE(IOUT, 52)
52 FORMAT('+ CARRY OVER FROM PRIOR YEARS.'/)
CALL ADUP(PRIOR)
IF(PRIOR.EQ.-99)GO TO 134
136 CALL TYP(24,I)
T24=PRIOR+OCA+OC+CO
WRITE(IOUT, 60)T24
CALL TYP(38,I)
WRITE(IOUT, 60)T24
137 WRITE(IOUT, 53)
53 FORMAT(/' ----- CASUALTY OR THEFT LOSSES'/)
CALL TYP(25,I)
54 FORMAT('+ LOSS BEFORE INSURANCE REIMBURSEMENT.'/)
WRITE(IOUT, 54)
CALL ADUP(RLOSS)
IF(RLOSS.EQ.-99)GO TO 135
IF(RLOSS.EQ.0)GO TO 139
138 CALL TYP(26,I)
WRITE(IOUT, 55)
55 FORMAT('+ INSURANCE REIMBURSEMENT.'/)
CALL ADUP(RIR)
IF(RIR.EQ.-99)GO TO 137
CALL TYP(27,I)
T27=RLOSS-RIR
IF(T27)T27=0
WRITE(IOUT, 60)T27
T28=100.
IF(T27.LT.T28)T28=T27
CALL TYP(28,I)
WRITE(IOUT, 2)T28
T29=T27-T28
CALL TYP(29,I)
WRITE(IOUT, 60)T29
CALL TYP(39,I)
WRITE(IOUT, 60)T29
139 WRITE(IOUT, 56)
56 FORMAT(/' ----- MISCELLANEOUS DEDUCTIONS '/)
CALL TYP(30,I)
WRITE(IOUT, 57)
57 FORMAT('+ ALIMONY PAID.'/)
CALL ADUP(ALIMON)
IF(ALIMON.EQ.-99)GO TO 138
140 CALL TYP(31,I)
WRITE(IOUT, 58)
58 FORMAT('+ UNION DUES.'/)
CALL ADUP(UN)
IF(UN.EQ.-99)GO TO 139
141 CALL TYP(32,I)
WRITE(IOUT, 59)
59 FORMAT('+ CHILD AND DEPENDENT CARE(FORM 2441)'/)
CALL ADUP(CAD)
IF(CAD.EQ.-99)GO TO 140
142 CALL TYP(33,I)
WRITE(IOUT, 26)
CALL ADUP(SOTH)
IF(SOTH.EQ.-99)GO TO 141
T34=ALIMONY+UN+CAD+SOTH
CALL TYP(34,I)
WRITE(IOUT, 60)T34
CALL TYP(40,I)
WRITE(IOUT, 60)T34
WRITE(IOUT, 63)
63 FORMAT(' ----- SUMMARY OF DEDUCTIONS.'/)
CALL TYP(35,I)
WRITE(IOUT, 64)T10
64 FORMAT('+ MEDICAL AND DENTAL.',F12.2/)
CALL TYP(36,I)
WRITE(IOUT, 65)T17
65 FORMAT('+ TOTAL TAXES.',F12.2/)
650 FORMAT('+ TOTAL INTEREST.',F12.2/)
66 FORMAT('+ TOTAL CONTRIBUTIONS.',F12.2/)
67 FORMAT('+ CASUALTY OR THEFT LOSS.',F12.2/)
68 FORMAT('+ TOTAL MISCELLANEAOUS.',F12.2/)
69 FORMAT('+ TOTAL DEDUCTIONS.',F12.2/)
CALL TYP(37,I)
WRITE(IOUT, 650)T20
CALL TYP(38,I)
WRITE(IOUT, 66)T24
CALL TYP(39,I)
WRITE(IOUT, 67)T29
CALL TYP(40,I)
WRITE(IOUT, 68)T34
CALL TYP(41,I)
T41=T34+T29+T20+T17+T10
WRITE(IOUT, 69)T41
WRITE(IOUT,602)
6900 CALL TYP(44,I)
WRITE(IOUT,32)T15
IF(JIT.NE.'Y')GO TO 6901
CALL TYP(45,'A')
WRITE(IOUT, 69)T41
6901 T45B=T15*.15
X=2000
IF(MFS.EQ.'Y')X=1000
IF(T45B.GT.X)T45B=X
CALL TYP(45,'B')
WRITE(IOUT, 69)T45B
T46=T15-T41
T46B=T15-T45B
IF(JIT.NE.'Y')GO TO 6902
CALL TYP(46,'A')
WRITE(IOUT, 2)T46
6902 CALL TYP(46,'B')
WRITE(IOUT, 2)T46B
CALL TYP(47,I)
X=EX*750
WRITE(IOUT, 70)X
70 FORMAT('+ EXEMPTIONS X $750.',F12.2/)
IF(JIT.NE.'Y')GO TO 71
CALL TYP(48,'A')
T48=T46-X
WRITE(IOUT, 71)T48
71 FORMAT('+ TAXABLE INCOME -- ',F12.2/)
T48B=T46B-X
CALL TYP(48,'B')
WRITE(IOUT, 71)T48B
7216 WRITE(IOUT, 72)
72 FORMAT(//' FIGURE YOUR TAX WITH SCHED. X,Y OR Z.'/
1' USE SMALLEST OF 48A OR 48B (UNLESS ZERO).'/)
IF(ACC.EQ.0)GO TO 73
1722 TYPE 722
722 FORMAT(' TYPE APPROPRIATE $, % AND $ FROM LAST 2 COLUMNS OF
1SCHEDULES X, Y OR Z.'/)
ACCEPT 1,X,Y,Z
IF(X.EQ.-99)GO TO 142
IF(Y.LT.1)GO TO 1722
C TYPE PERCENTAGE AS NON-DECIMAL NUM. I.E. 25=25% NOT! .25
IF(T48.LE.Z)GO TO 1722
IF(JIT.NE.'Y')T48=T48B
TAX=X+(T48-Z)*Y/100.
CC TAXB=X+(T48B-Z)*Y/100.
73 FORMAT('+ YOUR TAX -- ',F12.2/)
CALL TYP(16,I)
WRITE(IOUT,73)TAX
CC CALL TYP(16,'B')
CC WRITE(IOUT,73)TAXB
C****** CREDITS ********************
741 FORMAT(' ----- CREDITS'/)
WRITE(IOUT,741)
IF(ACC.EQ.0.AND.T54.EQ.0)GO TO 1605
1742 WRITE(IOUT,602)
CALL TYP(49,I)
742 FORMAT('+ RETIREMENT INCOME CREDIT. (SCHED. R) '/)
WRITE(IOUT,742)
CALL ADUP(RIC)
IF(RIC.EQ.-888)GO TO 6901
IF(RIC.EQ.-999)GO TO 1605
IF(RIC.EQ.-99)GO TO 7216
743 FORMAT('+ INVESTMENT CREDIT. (FORM 3468) '/)
CALL TYP(50,I)
WRITE(IOUT,743)
CALL ADUP(RIVC)
IF(RIVC.EQ.-99)GO TO 742
744 FORMAT('+ FOREIGN TAX CREDIT. (FORM 1116) '/)
CALL TYP(51,I)
WRITE(IOUT,744)
CALL ADUP(FTX)
IF(FTX.EQ.-99)GO TO 743
745 FORMAT('+ CREDIT FOR CONTRBS. TO CANDS. (SEE PG.9) '/)
CALL TYP(52,I)
WRITE(IOUT,745)
CALL ADUP(CCC)
IF(CCC.EQ.-99)GO TO 744
746 FORMAT('+ WORK INCENTIVE CREDIT. (FORM 4874) '/)
CALL TYP(53,I)
WRITE(IOUT,746)
CALL ADUP(WIC)
IF(WIC.EQ.-99)GO TO 745
CALL TYP(54,I)
T54=RIC+FTX+CCC+WIC+RIVC
WRITE(IOUT,60)T54
C******************************* PAGE 1 AGAIN ***********
WRITE(IOUT,603)
1605 CALL TYP(17,I)
IF(RIC.EQ.-999)RIC=0
WRITE(IOUT, 74)T54
74 FORMAT('+ TOTAL CREDITS.',F12.2/)
T18=TAX-T54
CALL TYP(18,I)
WRITE(IOUT, 75),T18
75 FORMAT('+ ******** INCOME TAX ******',F12.2/)
C******** BACK TO PAGE 2 **************************
760 FORMAT('+ SELF-EMPLOYMENT TAX. (SCHED. SE) '/)
IF(ACC.EQ.0.AND.T61.EQ.0)GO TO 1606
1760 WRITE(IOUT,602)
CALL TYP(55,I)
WRITE(IOUT,760)
CALL ADUP(SETX)
IF(SETX.EQ.-999)GO TO 1606
IF(SETX.EQ.-888)GO TO 6901
IF(SETX.EQ.-99)GO TO 74
761 FORMAT('+ TAX FROM RECOMPUTING INV.(FORM 4255) '/)
CALL TYP(56,I)
WRITE(IOUT,761)
CALL ADUP(TRI)
IF(TRI.EQ.-99)GO TO 760
762 FORMAT('+ TAX FROM RECOMPUTING WIN. (+ SCHED.) '/)
CALL TYP(57,I)
WRITE(IOUT,762)
CALL ADUP(TRW)
IF(TRW.EQ.-99)GO TO 761
763 FORMAT('+ MINIMUM TAX? (FORM 4725) '/)
CALL TYP(58,I)
WRITE(IOUT,763)
CALL ADUP(RMT)
IF(RMT.EQ.-99)GO TO 762
764 FORMAT('+ SOCIAL SECURITY TAX ON TIPS. (FORM 4137) '/)
CALL TYP(59,I)
WRITE(IOUT,764)
CALL ADUP(SST)
IF(SST.EQ.-99)GO TO 763
765 FORMAT('+ UNCOLLECTED SOC. SEC. TAX ON TIPS. '/)
CALL TYP(60,I)
WRITE(IOUT,765)
CALL ADUP(TIPS)
IF(TIPS.EQ.-99)GO TO 764
CALL TYP(61,I)
T61=TIPS+SST+RMT+TRW+TRI+SETX
WRITE(IOUT,60)T61
C***** BACK TO PG.1 *******
WRITE(IOUT,603)
1606 CALL TYP(19,I)
IF(SETX.EQ.-999)SETX=0
WRITE(IOUT, 76)T61
76 FORMAT('+ OTHER TAXES (LINE 61). ',F12.2/)
T20T=TAX+T61
CALL TYP(20,I)
WRITE(IOUT, 60)T20T
7721 CALL TYP(21,'A')
77 FORMAT('+ FEDERAL TAX WITHHELD.'/)
WRITE(IOUT, 77)
CALL ADUP(WT)
IF(WT.EQ.-99)GO TO 75
CALL TYP(21,'A')
WRITE(IOUT, 60)WT
78 FORMAT('+ 1973 ESTIMATED TAX PAYMENTS.'/)
CALL TYP(21,'B')
WRITE(IOUT, 78)
CALL ADUP(ET)
IF(ET.EQ.-99)GO TO 77
79 FORMAT('+ AMOUNT PAID WITH FORM 4868. '/)
CALL TYP(21,'C')
WRITE(IOUT, 79)
CALL ADUP(FORM)
IF(FORM.EQ.-99)GO TO 78
80 CALL TYP(21,'D')
WRITE(IOUT, 26)
IF(ACC.EQ.0.AND.T65.EQ.0)GO TO 1607
WRITE(IOUT,602)
800 FORMAT('+ EXCESS FICA TAX WITHHELD. (SEE PG.9) '/)
CALL TYP(62,I)
WRITE(IOUT,800)
CALL ADUP(FIC)
IF(FIC.EQ.-99)GO TO 78
IF(FIC.EQ.-999)GO TO 1607
IF(FIC.EQ.-888)GO TO 6901
801 FORMAT('+ CREDIT FOR FED. TAX ON FUELS. (FORM 4136) '/)
CALL TYP(63,I)
WRITE(IOUT,801)
CALL ADUP(FUEL)
IF(FUEL.EQ.-99)GO TO 800
802 FORMAT('+ CREDIT FROM REGULATED INVSTMT. CO. (FORM 2439) '/)
CALL TYP(64,I)
WRITE(IOUT,802)
CALL ADUP(CRICC)
IF(CRICC.EQ.-99)GO TO 801
T65=FIC+FUEL+CRICC
CALL TYP(65,T54,I)
WRITE(IOUT,60)T65
WRITE(IOUT,603)
1607 CALL TYP(21,'D')
IF(FIC.EQ.-999)FIC=0
WRITE(IOUT, 26)
IF(ACC.EQ.0)WRITE(IOUT,2)T65
T22=WT+ET+FORM+T65
CALL TYP(22,I)
WRITE(IOUT, 60)T22
T23=T20T-T22
T23T=T23
IF(T23T)T23T=0
CALL TYP(23,I)
82 FORMAT('+ BALANCE DUE. ------ ',F12.2/)
WRITE(IOUT, 82)T23T
T23=-T23
IF(T23)T23=0
CALL TYP(24,I)
WRITE(IOUT, 83)T23
83 FORMAT('+ OVERPAID ---------- ',F12.2)
CALL TYP(25,I)
WRITE(IOUT, 84)T23
84 FORMAT('+ REFUNDED TO YOU --- ',F12.2)
IF(IOUT.EQ.3)CALL EXIT
IF(ACC.EQ.0)GO TO 860
WRITE(IOUT, 85)
85 FORMAT(//' TYPE FILE NAME. '$)
ACCEPT 4,NAME
CALL OFILE(1,NAME)
WRITE(1)
1 RIC,FTX,CCC,WIC,RIVC,TIPS,SST,RMT,
1 TRW,TRI,SETX,FUEL,CRICC,FIC,ET,
1 JIT,T61,T65,T54,
1 EX,WG,DT,DEX,TOTD,RT,BI,CA,SU,RY,PE,CP,SI,
1 ALM,OT,T38,T13,SICK,RMEX,EB,SER,T43,T15,RMI
1,T1,RM,T4,T5,DO,HOSP,DOTH,T7,T8,T9,T10,TA,RX,GTAX,STAX
WRITE(1)PTAX,XO,T17,RMO,ROH,T20,CO,OC,OCA,PRIOR,T24,RLOSS,RIR,
1 T27,T28,T29,ALIMON,UN,SOTH,T34,T10,T17,T41,T45B,T46,T46B
1,T48,T48B,TAX,T18,CRED,T20T,WT,FORM,T22,OTX
1,T23T,T23,K
GO TO 5
201 CALL IFILE(21,NAME)
READ(21)
1 RIC,FTX,CCC,WIC,RIVC,TIPS,SST,RMT,
1 TRW,TRI,SETX,FUEL,CRICC,FIC,ET,
1 JIT,T61,T65,T54,
1 EX,WG,DT,DEX,TOTD,RT,BI,CA,SU,RY,PE,CP,SI,
1 ALM,OT,T38,T13,SICK,RMEX,EB,SER,T43,T15,RMI
1,T1,RM,T4,T5,DO,HOSP,DOTH,T7,T8,T9,T10,TA,RX,GTAX,STAX
READ(21)PTAX,XO,T17,RMO,ROH,T20,CO,OC,OCA,PRIOR,T24,RLOSS,RIR,
1 T27,T28,T29,ALIMON,UN,SOTH,T34,T10,T17,T41,T45B,T46,T46B
1,T48,T48B,TAX,T18,CRED,T20T,WT,FORM,T22,OTX
1,T23T,T23,K
860 TYPE 86
86 FORMAT(' R=REWORK, T=TYPE ON TTY, L=LIST ON LPT.'/)
ACCEPT 3,N
IF(N.EQ.'R')GO TO 87
ACC=0
IF(N.EQ.'T')GO TO 4
IOUT=3
GO TO 4
87 TYPE 88
88 FORMAT(' START AT LINE 9,16,21,28,39,44,49,55,62 -- OR IN
1 SCHED. A, 1,11,18,25,30?'/)
ACCEPT 1,X
K=X
IF(K.GT.30)GO TO 89
GO TO(119,1,1,1,1,1,1,1, 1100,1, 43,1,1,1,1, 7216,1, 130,
1 1,1, 7721,1,1,1, 137,1,1, 17,1, 139)K
89 J=K-38
GO TO(27,1,1,1,1,6900)J
IF(K.EQ.49)GO TO 1742
IF(K.EQ.55)GO TO 1760
IF(K.EQ.62)GO TO 800
5 END